home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / os2 / savefldr.zip / SAVEFLDR.CMD < prev    next >
OS/2 REXX Batch file  |  1993-03-22  |  59KB  |  1,560 lines
  1. /**********************************************/
  2. /* SAVEFLDR.CMD                               */
  3. /*                                            */
  4. /* Created by GENDLG version 1.4              */
  5. /*                                            */
  6. /* 03/22/93 11:00:22                          */
  7. /**********************************************/
  8. Trace 'O'
  9. Signal On Syntax
  10. Signal On Halt
  11.  
  12. /**************/
  13. /* Initialize */
  14. /**************/
  15. Parse source . . rexx_name
  16. rexx_dir = Filespec('D',rexx_name)||Filespec('P',rexx_name)
  17. If rexx_dir = '' Then rexx_dir = Directory()||'\'
  18. __dlgs_active = ''
  19. __dlgs_active_name = ''
  20. __wait_active = 0
  21. __dlgfile = rexx_dir||'SAVEFLDR.DLG'
  22. If RxFuncQuery('SysLoadFuncs') Then Do
  23.   Call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
  24.   Call SysLoadFuncs
  25. End
  26. If Rxfuncquery('dBoxMgr2') Then Call RxFuncAdd 'dBoxMgr2', 'dBoxMgr2', 'dBoxMgr2'
  27. Call dBoxMgr2 'START'
  28. If result = -1 Then Do
  29.   Say 'dBoxMgr2 could not be started.'
  30.   Call Endit 16
  31. End
  32. TRUE = 1
  33. FALSE = 0
  34. QUIT = FALSE
  35.  
  36. /******************/
  37. /* Initialization */
  38. /******************/
  39. If RxFuncQuery('MyLoadFuncs') Then Do
  40.   Call rxfuncadd myloadfuncs, myutil, myloadfuncs
  41.   Call myloadfuncs
  42. End
  43.  
  44. /****************************************/
  45. /* Tell user that we are alive and well */
  46. /****************************************/
  47. Call Wait "Processing .INI files."
  48.  
  49. /**********************/
  50. /* Get the debug flag */
  51. /**********************/
  52. debug = 0
  53. Parse Arg argstring
  54. If WordPos('/D',Translate(argstring)) > 0 Then Do
  55.   debug = 1
  56.   argstring = Subword(argstring,1,Wordpos('/D',Translate(argstring))-1)||Subword(argstring,Wordpos('/D',Translate(argstring))+1)
  57. End
  58. foldername = argstring
  59.  
  60. /**************/
  61. /* Initialize */
  62. /**************/
  63. inifile = Value('USER_INI',,'OS2ENVIRONMENT')
  64. sysinifile = Value('SYSTEM_INI',,'OS2ENVIRONMENT')
  65. ver = '1.6'
  66. oldver = SysIni(inifile,'SAVEFLDR','Version')
  67. If oldver = 'ERROR:' Then Do
  68.   cmddir = Substr(rexx_dir,1,Length(rexx_dir)-1)
  69.   Call SysCreateObject 'WPProgram', 'Save Folder^Contents', '<WP_DESKTOP>', 'PROGTYPE=WINDOWABLEVIO;MINIMIZED=YES;CCVIEW=NO;EXENAME='||cmddir||'\SAVEFLDR.CMD;OBJECTID=<SAVE_FOLDER>;STARTUPDIR='||cmddir||';', 'R'
  70.   Call SysIni inifile ,'SAVEFLDR','Version',ver
  71. End
  72. Else Do
  73.   If ver <> oldver Then Call SysIni inifile ,'SAVEFLDR','Version',ver
  74. End
  75. dumpfile = 'SAVEFLDR.DAT'
  76. cmdfile = 'MAKEFLDR.CMD'
  77. If debug Then Do
  78.   Call SysFileDelete dumpfile
  79.   Call Lineout dumpfile, "Debugging information of SAVEFLDR version" ver "on" Date() Time()"."
  80.   Call Lineout dumpfile, "Please send this file to 61804212 at VIEVMA."
  81.   Call Stream dumpfile, 'C', 'CLOSE'
  82.   '@SYSLEVEL >>'dumpfile
  83.   Parse Version With rexxversion
  84.   Call Lineout dumpfile, "Rexx version:" rexxversion
  85. End
  86.  
  87. /*****************/
  88. /* Get the nodes */
  89. /*****************/
  90. handlesapp = SysIni(sysinifile,'PM_Workplace:ActiveHandles', 'HandlesAppName')
  91. If handlesapp = 'ERROR:' Then handlesapp = 'PM_Workplace:Handles'
  92. block1 = ''
  93. Do i = 1 to 999
  94.   block = SysIni('SYSTEM', handlesapp, 'BLOCK'||i)
  95.   If block = 'ERROR:' Then Do
  96.     If i = 1 Then Do
  97.       Say "Unable to locate the INODE table, you are probably using OS/2 without the Service Pack."
  98.       Exit 8
  99.     End
  100.     Leave
  101.   End
  102.   block1 = block1||block
  103. End
  104. l = 0
  105. nodes. = 0
  106. i = 0
  107. Do Until l >= Length(block1)
  108.   If Substr(block1,l+5,4) = 'DRIV' Then Do
  109.     xl = Pos('00'x||'NODE'||'01'x,block1,l+5)-l
  110.     If xl <= 0 Then Leave
  111.     l = l + xl
  112.     Iterate
  113.   End
  114.   Else Do
  115.     If Substr(block1,l+1,4) = 'DRIV' Then Do
  116.       xl = Pos('00'x||'NODE'||'01'x,block1,l+1)-l
  117.       If xl <= 0 Then Leave
  118.       l = l + xl
  119.       Iterate
  120.     End
  121.     Else Do
  122.       data = Substr(block1,l+1,32)
  123.       xl = C2D(Substr(block1,l+31,1))
  124.       If xl <= 0 Then Leave
  125.       data = data||Substr(block1,l+33,xl+1)
  126.       l = l + Length(data)
  127.     End
  128.   End
  129.   i = i + 1
  130.   nodes.i = data
  131.   If debug Then Call Hexdump data, dumpfile
  132. End
  133. nodes.0 = i
  134.  
  135. /*************************************************/
  136. /* Get the name of the current desktop directory */
  137. /*************************************************/
  138. objnum = SysIni(inifile, 'PM_Workplace:Location', '<WP_DESKTOP>')
  139. desktop = Getpath(Substr(objnum,1,2))
  140.  
  141. /****************************************/
  142. /* Get the desktop directory file names */
  143. /****************************************/
  144. Call SysFileTree desktop||'\*', 'desk', 'DSO'
  145. /**********************************/
  146. /* Set the output data structures */
  147. /**********************************/
  148. out. = 0
  149. Do i = 1 to desk.0
  150.   f = Translate(desk.i)
  151.   out.f = f
  152. End
  153. cmd. = 0
  154. Do i = 1 to desk.0
  155.   f = Translate(desk.i)
  156.   cmd.f = f
  157. End
  158.  
  159. /*****************************/
  160. /* Get the association types */
  161. /*****************************/
  162. objtypes. = ''
  163. Call SysIni inifile,'PMWP_ASSOC_TYPE', 'ALL:', 'types'
  164. Do i = 1 to types.0
  165.   objids = SysIni(inifile,'PMWP_ASSOC_TYPE', types.i)
  166.   Do Forever
  167.     If objids = '' Then Leave
  168.     x = Pos('00'x,objids)
  169.     objid = Substr(objids,1,x-1)
  170.     If objtypes.objid <> '' Then objtypes.objid = objtypes.objid||','
  171.     objtypes.objid = objtypes.objid||types.i
  172.     objids = Substr(objids,x+1)
  173.   End
  174. End
  175.  
  176. /*******************************/
  177. /* Get the association filters */
  178. /*******************************/
  179. filters. = ''
  180. Call SysIni inifile,'PMWP_ASSOC_FILTER', 'ALL:', 'types'
  181. Do i = 1 to types.0
  182.   objids = SysIni(inifile,'PMWP_ASSOC_FILTER', types.i)
  183.   Do Forever
  184.     If objids = '' Then Leave
  185.     x = Pos('00'x,objids)
  186.     objid = Substr(objids,1,x-1)
  187.     If filters.objid <> '' Then filters.objid = filters.objid||','
  188.     filters.objid = filters.objid||types.i
  189.     objids = Substr(objids,x+1)
  190.   End
  191. End
  192.  
  193. /******************************************/
  194. /* Get the object id's of all WPS objects */
  195. /******************************************/
  196. Call SysIni inifile,'PM_Workplace:Location', 'ALL:', 'locs'
  197. Do i = 1 to locs.0
  198.   objnum = SysIni(inifile, 'PM_Workplace:Location', locs.i)
  199.   locs.i = C2X(Substr(objnum,2,1)||Substr(objnum,1,1)) locs.i
  200. End
  201.  
  202. /*********************/
  203. /* Create the tables */
  204. /*********************/
  205. list. = 0
  206. fldrfiles. = 0
  207. Call Getname desktop, 0
  208. fldrlist. = 0
  209. fldrdirs. = 0
  210. j = 0
  211. Do i = list.0-1 to 1 by -1
  212.   j = j + 1
  213.   fldrlist.j = Substr(list.i,3)
  214.   fldrdirs.j = fldrfiles.i
  215. End
  216. fldrlist.0 = j
  217.  
  218. If foldername <> '' Then Do
  219.   Do i = 1 to fldrlist.0
  220.     If foldername = fldrlist.i Then Do
  221.       Call Processfolder fldrdirs.i, foldername
  222.       Call SysFileDelete cmdfile
  223.       Call Make_output
  224.       Call Endit 0
  225.     End
  226.   End
  227. End
  228.  
  229. /**************/
  230. /* Main logic */
  231. /**************/
  232. Call Unwait
  233. Call Process_dialog 'SAVEFLDR_DIALOG'
  234.  
  235. Call Endit 0
  236. /*********************/
  237. /* End of main logic */
  238. /*********************/
  239.  
  240. /*************************************************/
  241. /* Fill the fields of the SAVEFLDR_DIALOG dialog */
  242. /*************************************************/
  243. FILL_SAVEFLDR_DIALOG:
  244. Call dBoxListFill SAVEFLDR_DIALOG, SAVEFLDR_LIST, 'fldrlist', LIT_END
  245. dlg_field = SAVEFLDR_LIST   /* This is the field where the cursor will be */
  246. Return 0
  247.  
  248. /*******************************************/
  249. /* Process button SAVEFLDR_DIALOG_GENERATE */
  250. /*******************************************/
  251. SAVEFLDR_DIALOG_GENERATE:
  252. loopi = Dboxquerylistindex(SAVEFLDR_DIALOG, SAVEFLDR_LIST, LIT_FIRST)
  253. If loopi < 0 Then Do
  254.   xrc = DboxCreateMbx(SAVEFLDR_DIALOG,"Please select a folder from the list.",MB_OK)
  255.   Return 0
  256. End
  257. Call Wait "Processing the selected folders."
  258. Do While loopi >= 0
  259.   curdir = loopi + 1
  260.   curfldr = Strip(DboxQuerylisttext(SAVEFLDR_DIALOG, SAVEFLDR_LIST, loopi))
  261.   Call Processfolder fldrdirs.curdir, curfldr
  262.   Call dBoxListSelect SAVEFLDR_DIALOG, SAVEFLDR_LIST, loopi, 0
  263.   loopi = Dboxquerylistindex(SAVEFLDR_DIALOG, SAVEFLDR_LIST, loopi)
  264. End
  265. Call Unwait
  266. done = 1
  267. Return 0
  268.  
  269. /***************************************/
  270. /* Process button SAVEFLDR_DIALOG_EXIT */
  271. /***************************************/
  272. SAVEFLDR_DIALOG_EXIT:
  273. If done = 1 Then Do
  274. /**************************************************************/
  275. /* Now create the .CMD file, and if requested, the debug file */
  276. /**************************************************************/
  277.   saveit = 1
  278.   Call Process_dialog 'OUTPUT_DIALOG'
  279.   If saveit = 0 Then Do
  280.     QUIT = TRUE
  281.     Return 0
  282.   End
  283.   If Stream(cmdfile, 'C', 'QUERY EXISTS') <> '' Then Do
  284.     xrc = Dboxcreatembx(SAVEFLDR_DIALOG, "The output file" cmdfile "already exists, do you want to overwrite it?", MB_YESNO)
  285.     If xrc <> MBID_YES Then Return 0
  286.     Call SysFileDelete cmdfile
  287.   End
  288.   Call Make_output
  289. End
  290. QUIT = TRUE
  291. Return 0
  292.  
  293. /***************************************/
  294. /* Process button SAVEFLDR_DIALOG_HELP */
  295. /***************************************/
  296. SAVEFLDR_DIALOG_HELP:
  297. '@VIEW SAVEFLDR'
  298. Return 0
  299.  
  300. /**************************************/
  301. /* Process button SAVEFLDR_DIALOG_ESC */
  302. /**************************************/
  303. SAVEFLDR_DIALOG_ESC:
  304. QUIT = TRUE
  305. Return 0
  306.  
  307. /***********************************************/
  308. /* Fill the fields of the OUTPUT_DIALOG dialog */
  309. /***********************************************/
  310. FILL_OUTPUT_DIALOG:
  311. Call dBoxSetText OUTPUT_DIALOG, OUTPUT_FILENAME, cmdfile
  312. dlg_field = OUTPUT_FILENAME   /* This is the field where the cursor will be */
  313. Return 0
  314.  
  315. /*************************************/
  316. /* Process button OUTPUT_DIALOG_SAVE */
  317. /*************************************/
  318. OUTPUT_DIALOG_SAVE:
  319. cmdfile = Dboxquerytext(OUTPUT_DIALOG, OUTPUT_FILENAME)
  320. If cmdfile = '' Then Do
  321.   Call Telluser "Please supply a file name, or press Exit."
  322.   Return 0
  323. End
  324. cmdfile = Translate(cmdfile)
  325. QUIT = TRUE
  326. Return 0
  327.  
  328. /*************************************/
  329. /* Process button OUTPUT_DIALOG_EXIT */
  330. /*************************************/
  331. OUTPUT_DIALOG_EXIT:
  332. saveit = 0
  333. QUIT = TRUE
  334. Return 0
  335.  
  336. /************************************/
  337. /* Process button OUTPUT_DIALOG_ESC */
  338. /************************************/
  339. OUTPUT_DIALOG_ESC:
  340. saveit = 0
  341. QUIT = TRUE
  342. Return 0
  343.  
  344. /********************/
  345. /* User subroutines */
  346. /********************/
  347.  
  348. /******************************/
  349. /* Get the folder information */
  350. /******************************/
  351. Processfolder:
  352. folderdir = Translate(Arg(1))
  353. foldername = Arg(2)
  354. Call SysIni inifile,'PM_Abstract:FldrContent', 'ALL:', 'fldrs'
  355. iconfile = ''
  356. Do i = 1 to fldrs.0
  357.   key = fldrs.i
  358.   flderid = ''
  359.   Do j = 1 to locs.0
  360.     If Word(locs.j,1) = key Then Do
  361.       flderid = Word(locs.j,2)
  362.       Leave
  363.     End
  364.   End
  365.   inode = Right(fldrs.i,4,'0')
  366.   inode = X2C(Substr(inode,3,2)||Substr(inode,1,2))
  367.   fldername = Getpath(inode)
  368.   If fldername = '' Then Iterate
  369. /* Note: On HPFS drives the directory name of the folder */
  370. /*       obtained via the nodes may not be exactly the   */
  371. /*       same as the uppercase directory name due to NLS */
  372. /*       problems. Therefore the following (clumsy) code */
  373. /*       to determine if they are really the same.       */
  374.   If fldername <> folderdir Then Do
  375.     If Length(fldername) <> Length(folderdir) Then Iterate
  376.     If Pos(' ',fldername) = 0 Then Iterate
  377.     tfile = fldername||'\SAVEFLDR.TMP'
  378.     tfile2 = folderdir||'\SAVEFLDR.TMP'
  379.     Call Lineout tfile, 'Test'
  380.     Call Stream tfile, 'C', 'CLOSE'
  381.     If Stream(tfile2, 'C', 'QUERY EXISTS') = '' Then Do
  382.       Call SysFileDelete tfile
  383.       Iterate
  384.     End
  385.     Call SysFileDelete tfile
  386.     fldername = folderdir
  387.   End
  388.   iconfile = ''
  389.   icondata = ''
  390.   xrc = MyGetEA(fldername, '.ICON', 'icondata')
  391.   If Length(icondata) > 5 Then Do
  392.     iconfile = 'F'||Right(key,4,'0')||'.ICO'
  393.     Call SysFileDelete iconfile
  394.     Call Charout iconfile, Substr(icondata,5)
  395.     Call Stream iconfile, 'C', 'CLOSE'
  396.   End
  397.   xrc = MyGetEA(fldername, '.CLASSINFO', 'classinfo')
  398.   If debug Then Call Hexdump classinfo, dumpfile
  399.   settings = ''
  400.   iconview = ''
  401.   treeview = ''
  402.   detailsview = ''
  403. /*
  404.   If substr(classinfo,57,1) <> '04'x Then Do
  405.     views = Substr(classinfo,57,1)
  406.     If views = '01'x Then iconview = iconview||',NONFLOWED,INVISIBLE'
  407.     If views = '02'x Then iconview = iconview||',NONFLOWED,NORMAL'
  408.     If views = '11'x Then iconview = iconview||',FLOWED,INVISIBLE'
  409.     If views = '12'x Then iconview = iconview||',FLOWED,NORMAL'
  410.     If views = '22'x Then iconview = iconview||',NONFLOWED,SMALL'
  411.     If views = '24'x Then iconview = iconview||',NONGRID,SMALL'
  412.     If views = '32'x Then iconview = iconview||',FLOWED,SMALL'
  413.   End
  414.   If Substr(classinfo,61,3) <> '444050'x Then Do
  415.     views = Substr(classinfo,61,3)
  416.     If views = '444010' Then treeview = treeview||',NOLINES,NORMAL'
  417.     If views = '644010' Then treeview = treeview||',NOLINES,SMALL'
  418.     If views = '414010' Then treeview = treeview||',NOLINES,INVISIBLE'
  419.     If views = '644050' Then treeview = treeview||',LINES,SMALL'
  420.     If views = '414050' Then treeview = treeview||',LINES,INVISIBLE'
  421.   End
  422. */
  423.   wpobject = Substr(classinfo,Pos('WPObject',classinfo))
  424.   If Bitand(Substr(wpobject,28,1),'20'x) <> '00'x Then settings = Strip(settings||'TEMPLATE=YES;')
  425.   If Substr(wpobject,32,1) = '01'x Then settings = Strip(settings||'MINWIN=HIDE;')
  426.   If Substr(wpobject,32,1) = '02'x Then settings = Strip(settings||'MINWIN=VIEWER;')
  427.   If Substr(wpobject,32,1) = '02'x Then settings = Strip(settings||'MINWIN=DESKTOP;')
  428.   If Substr(wpobject,36,1) = '01'x Then settings = Strip(settings||'CCVIEW=YES;')
  429.   If Substr(wpobject,36,1) = '02'x Then settings = Strip(settings||'CCVIEW=NO;')
  430.   If flderid = '' Then flderid = '<USER_'||Word(Filespec('N',foldername),1)||'>'
  431.   If iconview <> '' Then settings = 'ICONVIEW='||Substr(iconview,2)
  432.   If treeview <> '' Then settings = 'TREEVIEW='||Substr(treeview,2)
  433.   xflderid = "'OBJECTID="flderid||";"||settings||"'"
  434.   If iconfile <> '' Then xflderid = Substr(xflderid,1,Length(xflderid)-1)||'ICONFILE='||Directory()||iconfile||";'"
  435.   cmd.fldername = 'Call SysCreateObject "WPFolder", "'foldername'", "<WP_DESKTOP>", 'xflderid', "F"'
  436.   out.fldername = C2X(inode) "Folder" fldername flderid 'Title='foldername
  437.   iconfile = ''
  438.   objs = SysIni(inifile, 'PM_Abstract:FldrContent', key)
  439.   Do j = 1 to Length(objs) by 4
  440.     obj = C2X(Substr(objs,j+1,1)||Substr(objs,j,1))
  441.     If substr(obj,1,1) = '0' Then obj = Substr(obj,2)
  442.     If substr(obj,1,1) = '0' Then obj = Substr(obj,2)
  443.     If substr(obj,1,1) = '0' Then obj = Substr(obj,2)
  444.     objdata = SysIni(inifile,'PM_Abstract:Objects',obj)
  445.     If Pos('WPAbstract',objdata) > 0 Then Do
  446.       objtype = Substr(objdata,5,Pos('00'x,Substr(objdata,5))-1)
  447.       If objtype <> 'WPProgram' & objtype <> 'WPShadow' Then Iterate
  448.       Call Parseobj
  449.       If pgm = '' Then Do
  450.         xobj = Right(C2X(Substr(inode,2,1)||Substr(inode,1,1)),4,'0')
  451.         If substr(xobj,1,1) = '0' Then xobj = Substr(xobj,2)
  452.         If substr(xobj,1,1) = '0' Then xobj = Substr(xobj,2)
  453.         If substr(xobj,1,1) = '0' Then xobj = Substr(xobj,2)
  454.         xobjdata = SysIni(inifile,'PM_Abstract:Objects',xobj)
  455.         If xobjdata <> 'ERROR:' Then Do
  456.           If Pos('WPAbstract',xobjdata) > 0 Then Do
  457.             objdata = xobjdata
  458.             Call Parseobj
  459.             parameters = ''
  460.             settings = ''
  461.             If objid <> '' Then pgm = objid
  462.             iconfile = ''
  463.           End
  464.         End
  465.       End
  466.       setup = ''
  467.       If objtype = 'WPShadow' Then Do
  468.         If pgm <> '' Then setup=setup||'SHADOWID='||pgm||';'
  469.         objid = ''
  470.       End
  471.       Else Do
  472.         If pgm <> '' Then setup=setup||'EXENAME='||pgm||';'
  473.       End
  474.       If parameters <> '' Then setup=setup||'PARAMETERS='parameters||';'
  475.       If settings <> '' Then setup=setup||settings
  476.       If objid <> '' Then setup=setup||'OBJECTID='||objid||';'
  477.       If iconfile <> '' Then setup = setup||'ICONFILE='Directory()||'\'||iconfile||';'
  478.       k = out.fldername.0 + 1
  479.       cmd.fldername.k = '  Call SysCreateObject "'objtype'", "'Translate(Translate(Substr(objdata,xpos+17,title_l),'^','0a'x),' ','0d'x)'", "'flderid'", "'setup'", "F"'
  480.       out.fldername.k = '   ' obj objtype": Title="Translate(Translate(Substr(objdata,xpos+17,title_l),'^','0a'x),' ','0d'x) setup
  481.       out.fldername.0 = k
  482.       cmd.fldername.0 = k
  483.       iconfile = ''
  484.     End
  485.   End
  486. End
  487. Return 0
  488.  
  489. /********************************/
  490. /* Parse the object information */
  491. /********************************/
  492. /* Note: This routine tries to interpret the various undocumented */
  493. /*       fields of the object data. This routine might not work   */
  494. /*       future OS/2 releases.                                    */
  495. Parseobj:
  496. xpos = LastPos('WPAbstract',objdata)
  497. title_l = C2D(Substr(objdata,xpos+15,1))-1
  498. objid = Substr(objdata,Pos('WPObject',objdata))
  499. If objid <> '' Then Do
  500.   If lastpos('<',objid) > 0 & lastpos('>',objid) > 0 Then Do
  501.     objid = Substr(objdata,Lastpos('<',objdata),Lastpos('>',objdata)-Lastpos('<',objdata)+1)
  502.   End
  503.   Else Do
  504.     objid = ''
  505.   End
  506. End
  507. pgm = ''
  508. parameters = ''
  509. settings = ''
  510. If Substr(objdata,35,12) = 'WPProgramRef' Then Do
  511.   If debug Then Do
  512.     Call Lineout dumpfile, obj
  513.     Call Hexdump objdata, dumpfile
  514.   End
  515.   saveobjdata = objdata
  516.   objdata = Substr(objdata,1,Pos('WPAbstract',objdata))
  517.   If Substr(objdata,48,4) = '04000B00'x Then Do
  518.     pgmdatapos = Pos('04000B00'x,objdata,35)
  519.     pgmdataposl = C2D(Substr(objdata,pgmdatapos+4,1))
  520.     pgmtype = Substr(objdata,pgmdatapos+18,1)
  521.     Select
  522. /*
  523.   Here is the information you are looking for.
  524.   PROG_31_ENH               WIN-OS2 Full Screen Enhanced
  525.   PROG_31_ENHSEAMLESSVDM    WIN-OS2 Separate Session Enhanced
  526.   PROG_31_ENHSEAMLESSCOMMON WIN-OS2 Common Session Enhanced
  527. */
  528.       When pgmtype = '00'x Then settings = 'PROGTYPE=PM;'
  529.       When pgmtype = '01'x Then settings = 'PROGTYPE=FULLSCREEN;'
  530.       When pgmtype = '02'x Then settings = 'PROGTYPE=WINDOWABLEVIO;'
  531.       When pgmtype = '03'x Then settings = 'PROGTYPE=PM;'
  532.       When pgmtype = '04'x Then settings = 'PROGTYPE=VDM;'
  533.       When pgmtype = '07'x Then settings = 'PROGTYPE=WINDOWEDVDM;'
  534.       When pgmtype = '0C'x Then settings = 'PROGTYPE=WIN;'
  535.       When pgmtype = '0D'x Then settings = 'PROGTYPE=SEPARATEWIN;'
  536.       When pgmtype = '0E'x Then settings = 'PROGTYPE=WINDOWEDWIN;'
  537.       When pgmtype = '0F'x Then settings = 'PROGTYPE=SEPARATEWIN;'
  538.       When pgmtype = '10'x Then settings = 'PROGTYPE=WINDOWEDWIN;'
  539.       When pgmtype = '11'x Then settings = 'PROGTYPE=PROG_31_ENHSEAMLESSVDM;'
  540.       When pgmtype = '12'x Then settings = 'PROGTYPE=PROG_31_ENHSEAMLESSCOMMON;'
  541.       When pgmtype = '13'x Then settings = 'PROGTYPE=PROG_31_ENH;'
  542.       When pgmtype = '14'x Then settings = 'PROGTYPE=WIN;'
  543.       Otherwise Do
  544.         settings = 'PROGTYPE=????????'
  545.       End
  546.     End
  547.     pgm = Getpath(Substr(objdata,pgmdatapos+6,2))
  548.     If pgm = '' & Substr(objdata,pgmdatapos+6,2) = 'FFFF'x Then pgm = '*'
  549.     startupdir = Getpath(Substr(objdata,pgmdatapos+10,2))
  550.     If startupdir <> '' Then settings = Strip(settings||'STARTUPDIR='||startupdir||';')
  551.     pgmdatapos = pgmdatapos+pgmdataposl
  552.     If Pos('04000A00'x,objdata,pgmdatapos) > 0 Then Do
  553.       pgmpos = Pos('04000A00'x,objdata,pgmdatapos)
  554.       pgml = C2D(Substr(objdata,pgmpos+4,1))-5
  555.       If Substr(objdata,pgmpos+6,2) = '0000'x Then Do
  556.         xpgm = Substr(objdata,pgmpos+8,pgml)
  557.         Parse Var xpgm xpgm '00'x .
  558.         pgml = Length(xpgm)+9
  559.         If pgm = '' Then pgm = xpgm
  560.       End
  561.       Else Do
  562.         pgml = 6
  563.       End
  564.       If Substr(objdata,pgmpos+pgml,2) = '0100'x Then Do
  565.         parameters = Substr(objdata,pgmpos+pgml+2)
  566.         Parse Var parameters parameters '00'x .
  567.         pgml = pgml+Length(parameters)+3
  568.       End
  569.       If Substr(objdata,pgmpos+pgml,2) = '0200'x Then Do
  570.         ico = Substr(objdata,pgmpos+pgml+2)
  571.         Parse Var ico ico '00'x .
  572.         If ico <> '' Then settings = Strip(settings||'ICONFILE='||Strip(ico)||';')
  573.       End
  574.     End
  575.     If Pos('04000600'x,objdata,pgmdatapos) > 0 Then Do
  576.       setuppos = Pos('04000600'x,objdata,pgmdatapos)
  577.       setupl = C2D(Substr(objdata,setuppos+4,1))-2
  578.       xsettings = Translate(Substr(objdata,setuppos+6,setupl),';','00'x)||';'
  579.       If xsettings <> '' Then Do
  580.         ysettings = ''
  581.         Do Forever
  582.           Parse Var xsettings sl ';' xsettings
  583.           If sl = '' Then Leave
  584.           sl = 'SET' sl
  585.           ysettings = ysettings||sl||';'
  586.         End
  587.         settings = Strip(settings||ysettings)
  588.       End
  589.     End
  590.     openflags = Substr(objdata,Pos('04000700'x,objdata,pgmdatapos)+7,1)
  591.     If Bitand(openflags,'04'x) <> '00'x Then settings = Strip(settings||'MINIMIZED=YES;')
  592.     If Bitand(openflags,'80'x) <> '00'x Then settings = Strip(settings||'NOAUTOCLOSE=YES;')
  593.     objdata = saveobjdata
  594.     Call Setwpobject Substr(objdata,Pos('WPObject',objdata))
  595.     Return 0
  596.   End
  597.   If Substr(objdata,48,4) = '02000100'x Then Do
  598.     pgmdatapos = Pos('02000100'x,objdata,35)
  599.     If pgmdatapos > 0 Then Do
  600.       pgmtype = Substr(objdata,pgmdatapos+6,1)
  601.       Select
  602.         When pgmtype = '00'x Then settings = 'PROGTYPE=PM;'
  603.         When pgmtype = '01'x Then settings = 'PROGTYPE=FULLSCREEN;'
  604.         When pgmtype = '02'x Then settings = 'PROGTYPE=WINDOWABLEVIO;'
  605.         When pgmtype = '03'x Then settings = 'PROGTYPE=PM;'
  606.         When pgmtype = '04'x Then settings = 'PROGTYPE=VDM;'
  607.         When pgmtype = '07'x Then settings = 'PROGTYPE=WINDOWEDVDM;'
  608.         When pgmtype = '0C'x Then settings = 'PROGTYPE=WIN;'
  609.         When pgmtype = '0D'x Then settings = 'PROGTYPE=SEPARATEWIN;'
  610.         When pgmtype = '0E'x Then settings = 'PROGTYPE=WINDOWEDWIN;'
  611.         When pgmtype = '0F'x Then settings = 'PROGTYPE=SEPARATEWIN;'
  612.         When pgmtype = '10'x Then settings = 'PROGTYPE=WINDOWEDWIN;'
  613.         Otherwise settings = 'PROGTYPE=????????'
  614.       End
  615.       pgmpos = Pos('02000200'x,objdata,pgmdatapos)
  616.       If pgmpos > 0 Then Do
  617.         pgm = Getpath(Substr(objdata,pgmpos+6,2))
  618.         If pgm = '' Then Do
  619.           If Substr(objdata,pgmpos+6,2) = 'FFFF'x Then pgm = '*'
  620.         End
  621.       End
  622.       Else Do
  623.         pgmpos = Pos('03000900'x,objdata,pgmdatapos)
  624.         If pgmpos > 0 Then Do
  625.           pgml = C2D(Substr(objdata,pgmpos+4,1))-1
  626.           pgm = Substr(objdata,pgmpos+6,pgml)
  627.         End
  628.         Else Do
  629.           pgm = '????????.???'
  630.         End
  631.       End
  632.       dirpos = Pos('04000400'x,objdata,pgmpos)
  633.       If dirpos > 0 Then Do
  634.         dirinode = Substr(objdata,dirpos+4,2)
  635.         If dirinode <> '0000'x Then settings = Strip(settings||'STARTUPDIR='||Getpath(dirinode))||';'
  636.       End
  637.       parmpos = Pos('03000300'x,objdata,pgmpos)
  638.       If parmpos > 0 Then Do
  639.         parml = C2D(Substr(objdata,parmpos+4,1))-1
  640.         If parml > 0 Then parameters = Substr(objdata,parmpos+6,parml)
  641.       End
  642.       If Pos('04000600'x,objdata,pgmpos) > 0 Then Do
  643.         setuppos = Pos('04000600'x,objdata,pgmpos)
  644.         setupl = C2D(Substr(objdata,setuppos+4,1))-2
  645.         xsettings = Translate(Substr(objdata,setuppos+6,setupl),';','00'x)||';'
  646.         If xsettings <> '' Then Do
  647.           ysettings = ''
  648.           Do Forever
  649.             Parse Var xsettings sl ';' xsettings
  650.             If sl = '' Then Leave
  651.             sl = 'SET' sl
  652.             ysettings = ysettings||sl||';'
  653.           End
  654.           settings = Strip(settings||ysettings)
  655.         End
  656.       End
  657.       openflags = Substr(objdata,Pos('04000700'x,objdata,pgmpos)+7,1)
  658.       If Bitand(openflags,'04'x) <> '00'x Then settings = Strip(settings||'MINIMIZED=YES;')
  659.       If Bitand(openflags,'80'x) <> '00'x Then settings = Strip(settings||'NOAUTOCLOSE=YES;')
  660.       objdata = saveobjdata
  661.       Call Setwpobject Substr(objdata,Pos('WPObject',objdata))
  662.       Return 0
  663.     End
  664.   End
  665.   Call Telluser "Unsupported object:" obj". Please run SAVEFLDR with the /d flag, and send the file SAVEFLDR.DAT to 61804212 AT VIEVMA."
  666.   If debug Then Call Lineout dumpfile, "Unsupported object:" obj
  667. End
  668. If Pos('WPShadow',objdata,8) > 0 Then Do
  669.   If debug Then Do
  670.     Call Lineout dumpfile, obj
  671.     Call Hexdump objdata, dumpfile
  672.   End
  673.   inode = Substr(objdata,Pos('WPShadow',objdata,8)+15,2)
  674.   pgm = Getpath(inode)
  675. End
  676. Return 0
  677.  
  678. /***********************************************/
  679. /* Loop through the nodes to get the path info */
  680. /***********************************************/
  681. Getpath: Procedure Expose nodes.
  682. gpinode = Arg(1)
  683. gp = ''
  684. Do gpi = 1 to nodes.0
  685.   If Substr(nodes.gpi,7,2) = gpinode Then Do
  686.     gp = Substr(nodes.gpi,33,Length(nodes.gpi)-33)
  687.     gpparent = Substr(nodes.gpi,9,2)
  688.     Do Until gpparent = '0000'x
  689.       Do gpl = 1 to nodes.0
  690.         If Substr(nodes.gpl,7,2) = gpparent Then Do
  691.           gp = Substr(nodes.gpl,33,Length(nodes.gpl)-33)||'\'||gp
  692.           gpparent = Substr(nodes.gpl,9,2)
  693.           Leave
  694.         End
  695.       End
  696.     End
  697.     Leave
  698.   End
  699. End
  700. Return gp
  701.  
  702. /***************************/
  703. /* Get the object settings */
  704. /***************************/
  705. Setwpobject: Procedure Expose settings objtypes. filters.
  706. wpobject = Arg(1)
  707. If Bitand(Substr(wpobject,28,1),'20'x) <> '00'x Then settings = Strip(settings||'TEMPLATE=YES;')
  708. If Substr(wpobject,32,1) = '01'x Then settings = Strip(settings||'MINWIN=HIDE;')
  709. If Substr(wpobject,32,1) = '02'x Then settings = Strip(settings||'MINWIN=VIEWER;')
  710. If Substr(wpobject,32,1) = '02'x Then settings = Strip(settings||'MINWIN=DESKTOP;')
  711. If Substr(wpobject,36,1) = '01'x Then settings = Strip(settings||'CCVIEW=YES;')
  712. If Substr(wpobject,36,1) = '02'x Then settings = Strip(settings||'CCVIEW=NO;')
  713. objnum = Substr(wpobject,52)
  714. Parse Var objnum objnum '@' .
  715. If objtypes.objnum <> '' Then settings = Strip(settings||'ASSOCTYPE='||objtypes.objnum';')
  716. If filters.objnum <> '' Then settings = Strip(settings||'ASSOCFILTER='||filters.objnum';')
  717. Return 0
  718.  
  719. /*********************************/
  720. /* Dump the data in hex and char */
  721. /*********************************/
  722. Hexdump: Procedure
  723. val = Arg(1)
  724. outfile = Arg(2)
  725. hex_string2 = Xrange("00"x, "1F"x)||'FF'x
  726. table_o = Copies("FA"x, Length(hex_string2))
  727. lines = Length(val)/16
  728. Parse Var lines lines '.' .
  729. rest = Length(val) - (lines*16)
  730. curpos = 0
  731. index = 1
  732. data. = ''
  733. data.0 = 0
  734. Do i = 1 to lines
  735.   data.i = Right(curpos,5) D2X(curpos,4)' '
  736.   Do 8
  737.     data.i = data.i C2X(Substr(val,index,2))
  738.     index = index + 2
  739.   End
  740.   data.i = Left(data.i,53) "'"Translate(Substr(val,curpos+1,16),table_o,hex_string2)"'"
  741.   curpos = curpos + 16
  742.   data.0 = i
  743. End
  744. If rest > 0 Then Do
  745.   i = data.0 + 1
  746.   data.i = Right(curpos,5) D2X(curpos,4)' '
  747.   Do Forever
  748.     If rest <= 0 Then Leave
  749.     If rest >= 2 Then Do
  750.       data.i = data.i C2X(Substr(val,index,2))
  751.       index = index + 2
  752.       rest = rest - 2
  753.     End
  754.     Else Do
  755.       data.i = data.i C2X(Substr(val,index,1))
  756.       index = index + 1
  757.       rest = rest - 1
  758.     End
  759.   End
  760.   data.i = Left(data.i,53) "'"Translate(Substr(val,curpos+1,16),table_o,hex_string2)"'"
  761.   data.0 = i
  762. End
  763. Call Lineout outfile, "Data length="Length(val)
  764. Do i = 1 to data.0
  765.   Call Lineout outfile, data.i
  766. End
  767. Return 0
  768.  
  769. /***********************/
  770. /* Write the .CMD file */
  771. /***********************/
  772. Writeit: Procedure
  773. fn = Arg(1)
  774. data = Arg(2)
  775. x = Pos(',',data)
  776. x = Pos(',',data,x+1)
  777. x = Pos(',',data,x+1)
  778. Call Lineout fn, Substr(data,1,x)','
  779. data = Strip(Substr(data,x+1))
  780. Do While Length(data) > 63
  781.   x = Lastpos(';',data,62)
  782.   If x = 0 Then Leave
  783.   If Substr(data,x+1,1) = '"' Then Leave
  784.   Call Lineout fn, '     ' Substr(data,1,x)||'"||,'
  785.   data = '"'||Substr(data,x+1)
  786. End
  787. Call Lineout fn, '     ' data
  788. Return 0
  789.  
  790. /*****************************************************/
  791. /* Get the folder names from the desktop directories */
  792. /*****************************************************/
  793. Getname: Procedure Expose list. fldrfiles.
  794. dir = Arg(1)
  795. right = Arg(2)
  796. Call SysFileTree dir||'\*.*', 'dirs', 'DO'
  797. If dirs.0 > 0 Then Do
  798.   Do i = 1 to dirs.0
  799.     Call Getname dirs.i, right + 2
  800.   End
  801. End
  802. xrc = MyGetEA(dir, '.LONGNAME', 'longname')
  803. x = list.0 + 1
  804. list.x = Copies(' ',right)||Translate(Translate(Substr(longname,5),'^','0a'x),' ','0d'x)
  805. /*
  806. Do Forever
  807.   If pos('0d'x,list.x) = 0 Then Leave
  808.   list.x = Substr(list.x,1,Pos('0d'x,list.x)-1) || Substr(list.x,Pos('0d'x,list.x)+1)
  809. End
  810. */
  811. fldrfiles.x = dir
  812. list.0 = x
  813. Return 0
  814.  
  815. /**************************/
  816. /* Write the command file */
  817. /**************************/
  818. Make_output:
  819. Call Lineout cmdfile, "/***********************************************************/"
  820. Call Lineout cmdfile, "/* Created by SAVEFLDR Version" ver "at" Date() Time() "*/"
  821. Call Lineout cmdfile, "/***********************************************************/"
  822. Call Lineout cmdfile, " "
  823. Call Lineout cmdfile, "If RxFuncQuery('SysLoadFuncs') Then Do"
  824. Call Lineout cmdfile, "  Call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'"
  825. Call Lineout cmdfile, "  Call SysLoadFuncs"
  826. Call Lineout cmdfile, "End"
  827. Call Lineout cmdfile, " "
  828. f = Translate(desktop)
  829. If out.f.0 <> 0 Then Do
  830.   Call Writeit cmdfile, cmd.f
  831.   Parse Var cmd.f . ',' '"'cfolder'"' .
  832.   Call Lineout cmdfile, 'If Result <> 1 Then Say "Unable to create the folder' cfolder'"'
  833.   If debug Then Call Lineout dumpfile, out.f
  834.   Do j = 1 to out.f.0
  835.     Call Writeit cmdfile, cmd.f.j
  836.     Parse Var cmd.f.j . ',' '"'otitle'"' .
  837.     Call Lineout cmdfile, '  If Result <> 1 Then Say "Unable to create the object' otitle 'in the folder' cfolder'"'
  838.     If debug Then Call Lineout dumpfile, out.f.j
  839.   End
  840.   Call Lineout cmdfile, " "
  841. End
  842. Do i = 1 to desk.0
  843.   f = Translate(desk.i)
  844.   If out.f.0 = 0 Then Iterate
  845.   Call Writeit cmdfile, cmd.f
  846.   Parse Var cmd.f . ',' '"'cfolder'"' .
  847.   Call Lineout cmdfile, 'If Result <> 1 Then Say "Unable to create the folder' cfolder'"'
  848.   If debug Then Call Lineout dumpfile, out.f
  849.   Do j = 1 to out.f.0
  850.     Call Writeit cmdfile, cmd.f.j
  851.     Parse Var cmd.f.j . ',' '"'otitle'"' .
  852.     Call Lineout cmdfile, '  If Result <> 1 Then Say "Unable to create the object' otitle 'in the folder' cfolder'"'
  853.     If debug Then Call Lineout dumpfile, out.f.j
  854.   End
  855.   Call Lineout cmdfile, " "
  856. End
  857. Call Lineout cmdfile, "Exit 0"
  858. Call Stream cmdfile, 'C', 'CLOSE'
  859. Return 0
  860.  
  861. /***************************/
  862. /* End of user subroutines */
  863. /***************************/
  864.  
  865. /****************/
  866. /* Exit program */
  867. /****************/
  868. Endit:
  869. __exitrc = Arg(1)
  870. /************************/
  871. /* User exit processing */
  872. /************************/
  873.  
  874. /*******************************/
  875. /* End of user exit processing */
  876. /*******************************/
  877. If __exitrc = '' Then __exitrc = 0
  878. Do i = 1 to Words(__dlgs_active)
  879.   Call dBoxDestroy Word(__dlgs_active,i)
  880. End
  881. If __wait_active Then Call dBoxDestroy __WAIT_DIALOG
  882. Exit __exitrc
  883.  
  884. /***********************/
  885. /* Process the dialogs */
  886. /***********************/
  887. Process_dialog:
  888. __cur_dialog_name = Arg(1)
  889. Call Dlg_Process __dlgfile, __cur_dialog_name, 1
  890. __cur_dialog = Value(__cur_dialog_name)
  891. __dlgs_active = __dlgs_active __cur_dialog
  892. __dlgs_active_name = __dlgs_active_name __cur_dialog_name
  893. Interpret 'Call FILL_'||__cur_dialog_name
  894. Do Forever
  895.   __dlg_button = Dboxprocess(__cur_dialog, dlg_field, 1)
  896.   If __dlg_button > 0 Then __dlg_button = __Fix_button(Dboxquerytext(__cur_dialog,__dlg_button))
  897.   Else Do
  898.     If __dlg_button = 0 Then __dlg_button = 'ESC'
  899.     Else Do
  900.       Call Telluser "Invalid button" __dlg_button", dialog="__cur_dialog"."
  901.       Call Endit 99
  902.     End
  903.   End
  904.   QUIT = FALSE
  905.   Interpret 'Call' __cur_dialog_name||'_'||__dlg_button
  906.   __cur_dialog = Word(__dlgs_active,Words(__dlgs_active))
  907.   __cur_dialog_name = Word(__dlgs_active_name,Words(__dlgs_active_name))
  908.   If QUIT = TRUE Then Leave
  909. End
  910. QUIT = FALSE
  911. Call dBoxDestroy __cur_dialog
  912. __dlgs_active = Subword(__dlgs_active,1,Words(__dlgs_active)-1)
  913. __dlgs_active_name = Subword(__dlgs_active_name,1,Words(__dlgs_active_name)-1)
  914. Return 0
  915.  
  916. /************************************************************************/
  917. /* Subroutine: Dlg_process                                              */
  918. /*                                                                      */
  919. /* Security Classification: IBM Internal Use Only                       */
  920. /*                                                                      */
  921. /*   Function: Create and optionally execute the dBoxMgr calls from     */
  922. /*             an OS/2 .DLG file.                                       */
  923. /*                                                                      */
  924. /*   Written by:  George Haschek (61804212 at VIEVMA)                   */
  925. /*                                                                      */
  926. /* Input Parameters:                                                    */
  927. /*      Parameter 1: .DLG Filename                                      */
  928. /*                2: Dialog name withing the .DLG file.                 */
  929. /*                3: Flag:                                              */
  930. /*                      0 = Don't process dialog. The calls for dBoxMgr */
  931. /*                          are saved in the stem __dlgp_stem. The      */
  932. /*                          variable __dlgp_stem.0 contains the number  */
  933. /*                          of entries in the stem.                     */
  934. /*                      1 = Call dBoxMgr directly.                      */
  935. /*      Return codes:                                                   */
  936. /*            -100 ... Dialog file not found                            */
  937. /*            -101 ... Dialog not found in DLG file                     */
  938. /*               0 ... OK                                               */
  939. /*           other ... Return codes from dBoxMgr                        */
  940. /*                                                                      */
  941. /* Note: This routine will create a NOVALUE condition the first time it */
  942. /*       is called.                                                     */
  943. /*                                                                      */
  944. /*   Summary of Changes:                                                */
  945. /*                                                                      */
  946. /*      05/06/91 V1.0 Shipped                                           */
  947. /*      ---------------------------------------------------------       */
  948. /*      05/06/91      Entry field should not allow WS_GROUP             */
  949. /*      05/06/91      Push Button should not allow WS_GROUP             */
  950. /*      05/06/91      Fix dialog size and position                      */
  951. /*      05/06/91      Change return codes (-100 = .DLG file not found,  */
  952. /*                                       -101 = dialog not found in     */
  953. /*                                              .DLG file.              */
  954. /*      05/07/91 V1.1 Shipped                                           */
  955. /*      ---------------------------------------------------------       */
  956. /*      05/09/91      Make it work with OS/2 2.0 dialog files           */
  957. /*      05/10/91 V1.2 Shipped                                           */
  958. /*      ---------------------------------------------------------       */
  959. /*      07/27/92      Add MLE                                           */
  960. /*      07/27/92 V1.3 Shipped                                           */
  961. /*      ---------------------------------------------------------       */
  962. /*      08/20/92      Numerous fixes by Greg Smyth                      */
  963. /*      08/27/92 V1.4 Shipped                                           */
  964. /*                                                                      */
  965. /************************************************************************/
  966. Dlg_Process:
  967. If Translate(Arg(1)) <> __dlgp_filename Then Do
  968.   __dlgp_filename = Translate(Arg(1))
  969.   __dlgp_data. = ''
  970. End
  971. __dlgp_dlgname = Translate(Arg(2))
  972. __dlgp_switch = Arg(3)
  973. __dlgp_rc = -101
  974. __dlgp_i = 0
  975. If Datatype(__dlgp_data.0) <> 'NUM' Then Do
  976.   If Stream(__dlgp_filename,'C','QUERY EXISTS') <> '' Then Do
  977.     __dlgp_data. = ''
  978.     Do Until Lines(__dlgp_filename) = 0
  979.       __dlgp_i = __dlgp_i + 1
  980.       __dlgp_data.__dlgp_i = Strip(Linein(__dlgp_filename))
  981.       If Wordpos(Word(__dlgp_data.__dlgp_i,1),'DLGINCLUDE DLGTEMPLATE BEGIN DIALOG CONTROL END PUSHBUTTON DEFPUSHBUTTON LTEXT RTEXT CTEXT CHECKBOX AUTOCHECKBOX RADIOBUTTON AUTORADIOBUTTON ENTRYFIELD COMBOBOX LISTBOX MLE { } GROUPBOX') = 0 Then Do
  982.         __dlgp_j = __dlgp_i - 1
  983.         If Right(__dlgp_data.__dlgp_j, 1) = '"' & Left(__dlgp_data.__dlgp_i, 1) = '"' Then Do
  984.           __dlgp_data.__dlgp_j = Left(__dlgp_data.__dlgp_j, Length(__dlgp_data.__dlgp_j) - 1)||SubStr(__dlgp_data.__dlgp_i, 2)
  985.         End
  986.         Else Do
  987. /*
  988.           If Left(__dlgp_data.__dlgp_j,1) = '|' Then __dlgp_data.__dlgp_j = __dlgp_data.__dlgp_j || ' '
  989.           __dlgp_data.__dlgp_j = __dlgp_data.__dlgp_j||__dlgp_data.__dlgp_i
  990. */
  991.           __dlgp_data.__dlgp_j = __dlgp_data.__dlgp_j __dlgp_data.__dlgp_i
  992.         End
  993.         __dlgp_data.__dlgp_i = ''
  994.         __dlgp_i = __dlgp_i - 1
  995.       End
  996.     End
  997.     Call Stream __dlgp_filename, 'C', 'CLOSE'
  998.     __dlgp_data.0 = __dlgp_i
  999.   End
  1000.   Else Do
  1001.     Call Telluser "Unable to find the file" __dlgp_filename".",1
  1002.     Call Endit 16
  1003.   End
  1004. End
  1005. __dlgp_line = ''
  1006. __dlgp_found = 0
  1007. __dlgp_stem. = ''
  1008. __dlgp_stem.0 = 0
  1009. Do __dlgp_i = 1 to __dlgp_data.0
  1010.   Parse Var __dlgp_data.__dlgp_i __dlgp_cmd __dlgp_parms
  1011.   __dlgp_cmd = Translate(__dlgp_cmd)
  1012.   If __dlgp_found = 0 Then Do
  1013.     If __dlgp_cmd <> 'DIALOG' Then Iterate
  1014.   End
  1015.   __dlgp_text_end = LastPos('"', __dlgp_parms)
  1016.   __dlgp_text = Left(__dlgp_parms, __dlgp_text_end)
  1017.   __dlgp_rest = SubStr(__dlgp_parms, __dlgp_text_end + 1)
  1018.   Parse Var __dlgp_rest . ',' __dlgp_id ',' __dlgp_x ',' __dlgp_y ',' __dlgp_cx ',' __dlgp_cy ',' __dlgp_class ',' __dlgp_style
  1019.   If Datatype(__dlgp_id) = 'NUM' Then Do
  1020.     If __dlgp_id < 0 Then __dlgp_id = 0-__dlgp_id
  1021.     __dlgp_id = 0 + __dlgp_id
  1022.     __dlgp_id = 'DLG_'||Strip(__dlgp_id)
  1023.   End
  1024.   __dlgp_id = Strip(__dlgp_id)
  1025.   __dlgp_class = Translate(__dlgp_class)
  1026.   __dlgp_style = Translate(__dlgp_style)
  1027.   __dlgp_text = Strip(__dlgp_text)
  1028.   Select
  1029.     When __dlgp_cmd = 'DIALOG' Then Do
  1030.       __dlgp_dlg_id = __dlgp_id
  1031.       If __dlgp_found = 0 Then Do
  1032.         If __dlgp_dlgname <> Translate(__dlgp_dlg_id) Then Iterate
  1033.         __dlgp_found = 1
  1034.       End
  1035.       Else Do
  1036.         Leave
  1037.       End
  1038.       __dlgp_x = Strip(Format(__dlgp_x / 420 * 1000,5,0))
  1039.       __dlgp_y = Strip(Format(__dlgp_y / 240 * 750,5,0))
  1040.       __dlgp_cx = __dlgp_cx + 6
  1041.       __dlgp_cy = __dlgp_cy + 16
  1042.       __dlgp_line = __dlgp_dlg_id '= DBoxCreate('Strip(__dlgp_text)','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1043.       __dlgp_stem.__dlgp_found = __dlgp_line
  1044.     End
  1045.     When __dlgp_cmd = 'CONTROL' Then Do
  1046.       Select
  1047.         When __dlgp_class = 'WC_BUTTON' Then Do
  1048.           If Pos('BS_RADIOBUTTON',__dlgp_style) > 0 | Pos('BS_AUTORADIOBUTTON',__dlgp_style) > 0 Then Do
  1049.             Call __dlgp_radio
  1050.           End
  1051.           If Pos('BS_CHECKBOX',__dlgp_style) > 0 | ,
  1052.                 Pos('BS_AUTOCHECKBOX',__dlgp_style) > 0 Then Do
  1053.              Call __dlgp_check
  1054.           End
  1055.           If Pos('BS_3STATE',__dlgp_style) > 0 | ,
  1056.                 Pos('BS_AUTO3STATE',__dlgp_style) > 0 Then Do
  1057.              Call __dlgp_3state
  1058.           End
  1059.           If Pos('BS_PUSHBUTTON',__dlgp_style) > 0 Then Do
  1060.             Call __dlgp_push
  1061.           End
  1062.           __dlgp_found = __dlgp_found + 1
  1063.           __dlgp_stem.__dlgp_found = __dlgp_line
  1064.         End
  1065.         When __dlgp_class = 'WC_LISTBOX' Then Do
  1066.           Call __dlgp_list
  1067.           __dlgp_found = __dlgp_found + 1
  1068.           __dlgp_stem.__dlgp_found = __dlgp_line
  1069.         End
  1070.         When __dlgp_class = 'WC_ENTRYFIELD' Then Do
  1071.           Call __dlgp_entry
  1072.           __dlgp_found = __dlgp_found + 1
  1073.           __dlgp_stem.__dlgp_found = __dlgp_line
  1074.         End
  1075.         When __dlgp_class = 'WC_COMBOBOX' Then Do
  1076.           Call __dlgp_combo
  1077.           __dlgp_found = __dlgp_found + 1
  1078.           __dlgp_stem.__dlgp_found = __dlgp_line
  1079.         End
  1080.         When __dlgp_class = 'WC_STATIC' Then Do
  1081.           Call __dlgp_text
  1082.           __dlgp_found = __dlgp_found + 1
  1083.           __dlgp_stem.__dlgp_found = __dlgp_line
  1084.         End
  1085.         When __dlgp_class = 'WC_SLIDER' Then Do
  1086.           Call __dlgp_slider
  1087.           __dlgp_found = __dlgp_found + 1
  1088.           __dlgp_stem.__dlgp_found = __dlgp_line
  1089.           If Wordpos('CTLDATA',__dlgp_style) > 0 Then Do
  1090.             Parse Var __dlgp_style . 'CTLDATA' __dlgp_idx1 ',' __dlgp_idx2 ',' __dlgp_scale1inc ',' __dlgp_scale1space ',' __dlgp_scale2inc ',' __dlgp_scale2space .
  1091.             __dlgp_found = __dlgp_found + 1
  1092.             __dlgp_stem.__dlgp_found = '__xrc = dBoxInitSlider('__dlgp_dlg_id ',' __dlgp_id ',' __dlgp_idx1 ',' __dlgp_idx2 ',' __dlgp_idx1')'
  1093.             __dlgp_found = __dlgp_found + 1
  1094.             __dlgp_stem.__dlgp_found = '__xrc = dBoxSetSlider('__dlgp_dlg_id ',' __dlgp_id ',' __dlgp_scale1inc ',' __dlgp_scale1space ',' __dlgp_scale2inc ',' __dlgp_scale2space')'
  1095.           End
  1096.         End
  1097.         When __dlgp_class = 'WC_SPINBUTTON' Then Do
  1098.           Call __dlgp_spin
  1099.           __dlgp_found = __dlgp_found + 1
  1100.           __dlgp_stem.__dlgp_found = __dlgp_line
  1101.         End
  1102.         Otherwise Do
  1103.           Call Telluser "Invalid class found."
  1104.           Call Telluser __dlgp_data.__dlgp_i,1
  1105.         End
  1106.       End
  1107.     End
  1108.     When __dlgp_cmd = 'PUSHBUTTON' | __dlgp_cmd = 'DEFPUSHBUTTON' Then Do
  1109.       __dlgp_style = __dlgp_class
  1110.       If __dlgp_cmd = 'DEFPUSHBUTTON' Then Do
  1111.         __dlgp_style = __dlgp_style '| BS_DEFAULT'
  1112.       End
  1113.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1114.       Call __dlgp_push
  1115.       __dlgp_found = __dlgp_found + 1
  1116.       __dlgp_stem.__dlgp_found = __dlgp_line
  1117.     End
  1118.     When __dlgp_cmd = 'CHECKBOX' | __dlgp_cmd = 'AUTOCHECKBOX' Then Do
  1119.       __dlgp_style = __dlgp_class
  1120.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1121.       Call __dlgp_check
  1122.       __dlgp_found = __dlgp_found + 1
  1123.       __dlgp_stem.__dlgp_found = __dlgp_line
  1124.     End
  1125.     When __dlgp_cmd = 'RADIOBUTTON' | __dlgp_cmd = 'AUTORADIOBUTTON' Then Do
  1126.       __dlgp_style = __dlgp_class
  1127.       Call __dlgp_radio
  1128.       __dlgp_found = __dlgp_found + 1
  1129.       __dlgp_stem.__dlgp_found = __dlgp_line
  1130.     End
  1131.     When __dlgp_cmd = 'LTEXT' | __dlgp_cmd = 'RTEXT' | __dlgp_cmd = 'CTEXT' Then Do
  1132.       __dlgp_style = __dlgp_class
  1133.       If Pos('DT_RIGHT',__dlgp_style) = 0 & Pos('DT_LEFT',__dlgp_style) = 0 & Pos('DT_CENTER',__dlgp_style) = 0 Then Do
  1134.         If __dlgp_cmd = 'LTEXT' Then __dlgp_style = __dlgp_style '| DT_LEFT'
  1135.         If __dlgp_cmd = 'RTEXT' Then __dlgp_style = __dlgp_style '| DT_RIGHT'
  1136.         If __dlgp_cmd = 'CTEXT' Then __dlgp_style = __dlgp_style '| DT_CENTER'
  1137.       End
  1138.       If Pos('DT_TOP',__dlgp_style) = 0 & Pos('DT_BOTTOM',__dlgp_style) = 0 & Pos('DT_VCENTER',__dlgp_style) = 0 Then Do
  1139.         __dlgp_style = __dlgp_style '| DT_TOP'
  1140.       End
  1141.       Call __dlgp_text
  1142.       __dlgp_found = __dlgp_found + 1
  1143.       __dlgp_stem.__dlgp_found = __dlgp_line
  1144.     End
  1145.     When __dlgp_cmd = 'ENTRYFIELD' Then Do
  1146.       __dlgp_style = __dlgp_class
  1147.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1148.       If Pos('ES_AUTOSCROLL',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| ES_AUTOSCROLL'
  1149.       Call __dlgp_entry
  1150.       __dlgp_found = __dlgp_found + 1
  1151.       __dlgp_stem.__dlgp_found = __dlgp_line
  1152.     End
  1153.     When __dlgp_cmd = 'COMBOBOX' Then Do
  1154.       __dlgp_style = __dlgp_class
  1155.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1156.       If Pos('CBS_SIBPLE',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| CBS_SIMPLE'
  1157.       Call __dlgp_combo
  1158.       __dlgp_found = __dlgp_found + 1
  1159.       __dlgp_stem.__dlgp_found = __dlgp_line
  1160.     End
  1161.     When __dlgp_cmd = 'LISTBOX' Then Do
  1162.       Parse Var __dlgp_parms __dlgp_id ',' __dlgp_x ',' __dlgp_y ',' __dlgp_cx ',' __dlgp_cy ',' __dlgp_style
  1163.       If Datatype(__dlgp_id) = 'NUM' Then Do
  1164.         If __dlgp_id < 0 Then __dlgp_id = 0-__dlgp_id
  1165.         __dlgp_id = 0 + __dlgp_id
  1166.         __dlgp_id = 'DLG_'||Strip(__dlgp_id)
  1167.       End
  1168.       __dlgp_id = Strip(__dlgp_id)
  1169.       __dlgp_style = Translate(__dlgp_style)
  1170.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1171.       Call __dlgp_list
  1172.       __dlgp_found = __dlgp_found + 1
  1173.       __dlgp_stem.__dlgp_found = __dlgp_line
  1174.     End
  1175.     When __dlgp_cmd = 'MLE' Then Do
  1176.       Parse Var __dlgp_parms . ',' __dlgp_id ',' __dlgp_x ',' __dlgp_y ',' __dlgp_cx ',' __dlgp_cy ',' __dlgp_style
  1177.       If Datatype(__dlgp_id) = 'NUM' Then Do
  1178.         If __dlgp_id < 0 Then __dlgp_id = 0-__dlgp_id
  1179.         __dlgp_id = 0 + __dlgp_id
  1180.         __dlgp_id = 'DLG_'||Strip(__dlgp_id)
  1181.       End
  1182.       __dlgp_id = Strip(__dlgp_id)
  1183.       __dlgp_style = Translate(__dlgp_style)
  1184.       If Pos('WS_TABSTOP',__dlgp_style) = 0 Then __dlgp_style = __dlgp_style '| WS_TABSTOP'
  1185.       Call __dlgp_mle
  1186.       __dlgp_found = __dlgp_found + 1
  1187.       __dlgp_stem.__dlgp_found = __dlgp_line
  1188.     End
  1189.     Otherwise Nop
  1190.   End
  1191. End
  1192. __dlgp_stem.0 = __dlgp_found
  1193. If __dlgp_found > 0 Then __dlgp_rc = 0
  1194. If __dlgp_switch = 1 Then Do
  1195.   Do __dlgp_i = 1 to __dlgp_stem.0
  1196.     Parse Var __dlgp_stem.__dlgp_i __dlgp_ident .
  1197.     Interpret __dlgp_stem.__dlgp_i
  1198.     xrc = Value(__dlgp_ident)
  1199.     If xrc < 0 Then Do
  1200.       __dlgp_rc = xrc
  1201.       Call Telluser "RC from dBoxMgr was" __dlgp_rc". The call was: >"Strip(__dlgp_stem.__dlgp_i)"<",1
  1202.     End
  1203.   End
  1204. End
  1205. Return __dlgp_rc
  1206.  
  1207. /**********************/
  1208. /* Process Pushbutton */
  1209. /**********************/
  1210. __dlgp_push:
  1211. __dlgp_style_val = '0'
  1212. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1213.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1214. End
  1215. If Pos('BS_DEFAULT',__dlgp_style) > 0 Then Do
  1216.   __dlgp_style_val = __dlgp_style_val'+BS_DEFAULT'
  1217. End
  1218. If Pos('BS_NOPOINTERFOCUS',__dlgp_style) > 0 Then Do
  1219.   __dlgp_style_val = __dlgp_style_val'+BS_NOPOINTERFOCUS'
  1220. End
  1221. __dlgp_line = __dlgp_id '= dBoxPush('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1222. Return 0
  1223.  
  1224. /************************/
  1225. /* Process Radio Button */
  1226. /************************/
  1227. __dlgp_radio:
  1228. __dlgp_style_val = '0'
  1229. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1230.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1231. End
  1232. If Pos('WS_GROUP',__dlgp_style) > 0 Then Do
  1233.   __dlgp_style_val = __dlgp_style_val'+WS_GROUP'
  1234. End
  1235. __dlgp_line = __dlgp_id '= dBoxRadio('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1236. Return 0
  1237.  
  1238. /*********************/
  1239. /* Process Check Box */
  1240. /*********************/
  1241. __dlgp_check:
  1242. __dlgp_style_val = '0'
  1243. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1244.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1245. End
  1246. __dlgp_line = __dlgp_id '= dBoxCheck('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1247. Return 0
  1248.  
  1249. /**************************/
  1250. /* Process 3 State Button */
  1251. /**************************/
  1252. __dlgp_3state:
  1253. __dlgp_style_val = '0'
  1254. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1255.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1256. End
  1257. If Pos('BS_NOPOINTERFOCUS',__dlgp_style) > 0 Then Do
  1258.   __dlgp_style_val = __dlgp_style_val'+BS_NOPOINTERFOCUS'
  1259. End
  1260. __dlgp_line = __dlgp_id '= dBox3State('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1261. Return 0
  1262.  
  1263. /***********************/
  1264. /* Process Entry Field */
  1265. /***********************/
  1266. __dlgp_entry:
  1267. __dlgp_style_val = '0'
  1268. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1269.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1270. End
  1271. Do __dlgp_j = 1 to Words(__dlgp_style)
  1272.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1273.     __dlgp_j = __dlgp_j + 1
  1274.     Iterate
  1275.   End
  1276.   If Pos(Word(__dlgp_style,__dlgp_j), 'ES_LEFT ES_RIGHT ES_CENTER ES_MARGIN ES_AUTOSCROLL ES_UNREADABLE') > 0 Then Do
  1277.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1278.   End
  1279. End
  1280. __dlgp_line = __dlgp_id '= dBoxEntry('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1281. Return 0
  1282.  
  1283. /***********************/
  1284. /* Process Static Text */
  1285. /***********************/
  1286. __dlgp_text:
  1287. __dlgp_style_val = '0'
  1288. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1289.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1290. End
  1291. Do __dlgp_j = 1 to Words(__dlgp_style)
  1292.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1293.     __dlgp_j = __dlgp_j + 1
  1294.     Iterate
  1295.   End
  1296.   If Pos(Word(__dlgp_style,__dlgp_j), 'DT_LEFT DT_RIGHT DT_CENTER DT_TOP DT_BOTTOM DT_VCENTER DT_WORDBREAK') > 0 Then Do
  1297.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1298.   End
  1299.   firstTilde = Pos('~', __dlgp_text)
  1300.   If Word(__dlgp_style, __dlgp_j) = 'DT_MNEMONIC' & firstTilde > 0 Then
  1301.     __dlgp_text = Left(__dlgp_text, firstTilde - 1)SubStr(__dlgp_text, firstTilde + 1)
  1302. End
  1303. __dlgp_line = __dlgp_id '= dBoxText('__dlgp_dlg_id','__dlgp_text','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1304. Return 0
  1305.  
  1306. /********************/
  1307. /* Process List Box */
  1308. /********************/
  1309. __dlgp_list:
  1310. __dlgp_style_val = '0'
  1311. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1312.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1313. End
  1314. Do __dlgp_j = 1 to Words(__dlgp_style)
  1315.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1316.     __dlgp_j = __dlgp_j + 1
  1317.     Iterate
  1318.   End
  1319.   If Pos(Word(__dlgp_style,__dlgp_j), 'LS_MULTIPLESEL LS_HORZSCROLL LS_NOADJUSTPOS') > 0 Then Do
  1320.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1321.   End
  1322. End
  1323. __dlgp_line = __dlgp_id '= dBoxList('__dlgp_dlg_id','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1324. Return 0
  1325.  
  1326. /*********************/
  1327. /* Process Combo Box */
  1328. /*********************/
  1329. __dlgp_combo:
  1330. __dlgp_style_val = '0'
  1331. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1332.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1333. End
  1334. Do __dlgp_j = 1 to Words(__dlgp_style)
  1335.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1336.     __dlgp_j = __dlgp_j + 1
  1337.     Iterate
  1338.   End
  1339.   If Pos(Word(__dlgp_style,__dlgp_j), 'CBS_SIMPLE CBS_DROPDOWN CBS_DROPDOWNLIST') > 0 Then Do
  1340.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1341.   End
  1342. End
  1343. __dlgp_line = __dlgp_id '= dBoxCombo('__dlgp_dlg_id','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1344. Return 0
  1345.  
  1346. /***************/
  1347. /* Process MLE */
  1348. /***************/
  1349. __dlgp_mle:
  1350. __dlgp_style_val = '0'
  1351. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1352.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1353. End
  1354. Do __dlgp_j = 1 to Words(__dlgp_style)
  1355.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1356.     __dlgp_j = __dlgp_j + 1
  1357.     Iterate
  1358.   End
  1359.   If Pos(Word(__dlgp_style,__dlgp_j), 'MLS_BORDER MLS_READONLY MLS_WORDWRAP MLS_HSCROLL MLS_VSCROLL MLS_IGNORETAB MLS_DISABLEUNDO') > 0 Then Do
  1360.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1361.   End
  1362. End
  1363. __dlgp_line = __dlgp_id '= dBoxMLE('__dlgp_dlg_id','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1364. Return 0
  1365.  
  1366. /******************/
  1367. /* Process Slider */
  1368. /******************/
  1369. __dlgp_slider:
  1370. __dlgp_style_val = '0'
  1371. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1372.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1373. End
  1374. Do __dlgp_j = 1 to Words(__dlgp_style)
  1375.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1376.     __dlgp_j = __dlgp_j + 1
  1377.     Iterate
  1378.   End
  1379.   If Wordpos(Word(__dlgp_style,__dlgp_j), 'SLS_HORIZONTAL SLS_VERTICAL SLS_CENTER SLS_BOTTOM SLS_TOP SLS_LEFT SLS_RIGHT SLS_PRIMARYSCALE1 SLS_PRIMARYSCALE2',
  1380.      'SLS_HOMELEFT SLS_HOMERIGHT SLS_HOMEBOTTOM SLS_HOMETOP SLS_BUTTONSLEFT SLS_BUTTONSTIGHT SLS_BUTTONSBOTTOM SLS_BUTTONSTOP SLS_SNAPTOINCREMENT SLS_READONLY SLS_RIBBONSTRIP') > 0 Then Do
  1381.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1382.   End
  1383. End
  1384. __dlgp_line = __dlgp_id '= dBoxSlider('__dlgp_dlg_id','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1385. Return 0
  1386.  
  1387. /***********************/
  1388. /* Process Spin button */
  1389. /***********************/
  1390. __dlgp_spin:
  1391. __dlgp_style_val = '0'
  1392. If Pos('WS_TABSTOP',__dlgp_style) > 0 Then Do
  1393.   __dlgp_style_val = __dlgp_style_val'+WS_TABSTOP'
  1394. End
  1395. Do __dlgp_j = 1 to Words(__dlgp_style)
  1396.   If Word(__dlgp_style,__dlgp_j) = 'NOT' Then Do
  1397.     __dlgp_j = __dlgp_j + 1
  1398.     Iterate
  1399.   End
  1400.   If Wordpos(Word(__dlgp_style,__dlgp_j), 'SPBS_MASTER SPBS_SERVANT SPBS_ALLCHARACTERS SPBS_NUMERICONLY SPBS_READONLY SPBS_JUSTLEFT SPBS_JUSTRIGHT SPBS_JUSTCENTER SPBS_NOBORDER SPBS_FASTSPIN SPBS PADWITHZERO') > 0 Then Do
  1401.     __dlgp_style_val = __dlgp_style_val'+'Word(__dlgp_style,__dlgp_j)
  1402.   End
  1403. End
  1404. __dlgp_line = __dlgp_id '= dBoxSpinButton('__dlgp_dlg_id','__dlgp_style_val','__dlgp_x','__dlgp_y','__dlgp_cx','__dlgp_cy')'
  1405. Return 0
  1406.  
  1407. /**********************************/
  1408. /* Show a panel during processing */
  1409. /**********************************/
  1410. Wait:
  1411. __wait_message = Arg(1)
  1412. If __wait_message = '' Then __wait_message = "The command is being processed."
  1413. Parse source . . __tell_name .
  1414. Parse Upper Value Filespec('name',__tell_name) With __tell_name '.' .
  1415. __message_length = Format(Max(Length(__wait_message),Length('Please wait...'))*4.8,4,0)
  1416. __WAIT_DIALOG = Dboxcreate(__tell_name,0,0,__message_length+15,56)
  1417. __dummy1 = Dboxtext(__WAIT_DIALOG,__wait_message,0+DT_CENTER+DT_VCENTER,4,23,__message_length,8)
  1418. __dummy2 = Dboxtext(__WAIT_DIALOG,"Please wait...",0+DT_CENTER+DT_VCENTER,4,11,__message_length,8)
  1419. Call dBoxShow __WAIT_DIALOG
  1420. __wait_active = 1
  1421. Return 0
  1422.  
  1423. /*************************/
  1424. /* Remove the wait panel */
  1425. /*************************/
  1426. Unwait:
  1427. Call DboxDestroy __WAIT_DIALOG
  1428. __wait_active = 0
  1429. Return 0
  1430.  
  1431. /***********************/
  1432. /* Fix the button name */
  1433. /***********************/
  1434. __Fix_button:
  1435. __newbutton = Translate(Strip(Arg(1)))
  1436. Do Forever
  1437.   __cerr = Verify(__newbutton,'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_')
  1438.   If __cerr = 0 Then Leave
  1439.   __newbutton = Overlay('_',__newbutton,__cerr)
  1440. End
  1441. Return __newbutton
  1442.  
  1443. /***************/
  1444. /* Notify user */
  1445. /***************/
  1446. Telluser:
  1447. Parse source . . __tell_name .
  1448. Parse Upper Var __tell_name __tell_logfile '.' .
  1449. __tell_logfile = __tell_logfile||'.LOG'
  1450. Parse Upper Value Filespec('name',__tell_name) With __tell_name '.' .
  1451. __tell_log = Arg(2)
  1452. If __tell_log = '' Then __tell_log = 0
  1453. If __tell_log <> '0' Then Do
  1454.   Call Lineout __tell_logfile, Date('U') Time() Arg(1)
  1455.   Call Stream __tell_logfile, 'C', 'CLOSE'
  1456.   __xrc = dBoxCreateMbx(0,__tell_name||':' Arg(1), MB_ICONHAND)
  1457. End
  1458. Else Do
  1459.   __xrc = dBoxCreateMbx(0,__tell_name||':' Arg(1), MB_OK)
  1460. End
  1461. Return 0
  1462.  
  1463. /*************************/
  1464. /* Handle SIGNAL ON HALT */
  1465. /*************************/
  1466. Halt:
  1467. Call Telluser 'Halt signalled in line' SIGL, 1
  1468. Call Endit 99
  1469.  
  1470. /***************************/
  1471. /* Handle SIGNAL ON SYNTAX */
  1472. /***************************/
  1473. Syntax:
  1474.   If symbol('RC') <> 'LIT' Then __error_rc = rc
  1475.   Else __error_rc = 0
  1476.   __save_sigl = sigl
  1477.   Call Telluser 'Rexx error on line' __save_sigl', RC =' __error_rc  errortext(__error_rc),1
  1478.   __src_line = Get_source(__save_sigl)
  1479.   Call Telluser 'Source line is: "'||__src_line||'"',1
  1480.   __src_parse = Parse_src(__src_line)
  1481.   __src_line = ''
  1482.   Do Until __src_parse = ''
  1483.     Parse Var __src_parse  __src_test  '00'x  __src_parse
  1484.     if symbol(__src_test) = 'BAD' then
  1485.          __src_line = __src_line || value('__src_test')
  1486.     else __src_line = __src_line || value(__src_test)
  1487.   end
  1488.   Call Telluser 'Source line interpreted as: "' || __src_line || '"',1
  1489.   Call Endit 99
  1490.  
  1491. /*********************************************************************
  1492. **  Get a complete line of source code
  1493. **   - Gets all source even if continued
  1494. **     (assumes continued lines end with a comma)
  1495. **   - Deletes simple comments
  1496. *********************************************************************/
  1497. Get_source: procedure
  1498.   parse arg src_line_no
  1499.   src_line = ''
  1500.   string = sourceline(src_line_no)
  1501.   cont = 0
  1502.   do until cont = 0          /* get rest if line continued */
  1503.     do while string <> ''    /* delete comments            */
  1504.       parse var string  src '/*' trash '*/' string
  1505.       src_line = src_line || src
  1506.     end
  1507.     src_line = strip(src_line)
  1508.     if substr(src_line,length(src_line)) = ',' then do
  1509.       src_line = delstr(src_line,length(src_line))
  1510.       cont = cont + 1
  1511.       string = sourceline(src_line_no + cont)
  1512.     end
  1513.     else cont = 0
  1514.   end
  1515.   return src_line
  1516.  
  1517. /*********************************************************************
  1518. **  parses line of source code
  1519. **   - returns source delimited by '00'x
  1520. **   - can be converted to an external function
  1521. *********************************************************************/
  1522. Parse_src: procedure
  1523.   parse arg src_line
  1524.   quote_list = '''"'
  1525.   delim_list = ' +-Ö/%*|ö&=^><,;:()'
  1526.  
  1527.   src_parse = ''
  1528.   do while src_line <> ''
  1529.     first = verify(src_line,quote_list,'M')
  1530.     if first = 1 then do
  1531.       quote = substr(src_line,first,1)
  1532.       last = pos(quote,src_line,first+1)
  1533.       if last = 0 then last = length(src_line)
  1534.       next.1 = substr(src_line,last+1,1)
  1535.       next.2 = substr(src_line,last+2,1)
  1536.       next.1 = translate(next.1)
  1537.       string = substr(src_line,first,last)
  1538.       if next.1 = 'X' | next.1 = 'B' then do
  1539.          if verify(next.2,delim_list||quote_list,'M') <> 0 then do
  1540.            last = last+1
  1541.            string = substr(src_line,first,last)
  1542.          end
  1543.       end
  1544.     end
  1545.     else do
  1546.       if first = 0 then first = length(src_line)+1
  1547.       string = substr(src_line,1,first-1)
  1548.       x = verify(string,delim_list,'M')
  1549.       y = verify(string,delim_list)
  1550.       if x = 0 then x = length(string)+1
  1551.       if y = 0 then y = length(string)+1
  1552.       last = max(x,y) - 1
  1553.       if substr(string,last+1,1) = '(' then last=last+1
  1554.       string = substr(string,1,last)
  1555.     end
  1556.     src_parse = src_parse || '00'x || string
  1557.     src_line = substr(src_line,last+1)
  1558.   end
  1559.   return  src_parse
  1560.